home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / turbo_tk.arc / PULLDEM.PAS < prev    next >
Pascal/Delphi Source File  |  1988-02-01  |  3KB  |  110 lines
  1. Program Illustrating_The_PullDown_Menu_Kit;
  2.  
  3. Uses Crt, FastTTT, DOS, WinTTT, KeyTTT, PullTTT;
  4.  
  5. { Notes:   1) The MenuDesc Type is an array of strings holding the
  6.               description of the menu titles.
  7.            2) The main headings of each pull down option must start
  8.               with a '\'.
  9.            3) The last choice in the array must be followed by a
  10.               string '\\'.
  11.   Thats all there is to it.}
  12.  
  13. var
  14. TheMenu : MenuDesc;   {Array holding the menu definitions}
  15.  
  16. Procedure Define_Demo_Menu;
  17. begin
  18.   Fillchar(Themenu,sizeof(Themenu),#0);
  19.   TheMenu[1] := '\File';      {menu definition for pull down menu}
  20.   TheMenu[2] := 'Load        ';
  21.   TheMenu[3] := 'New         ';
  22.   TheMenu[4] := 'Save        ';
  23.   TheMenu[5] := 'Write to    ';
  24.   TheMenu[6] := 'Directory   ';
  25.   TheMenu[7] := 'Change dir  ';
  26.   TheMenu[8] := 'OS shell    ';
  27.   TheMenu[9] := 'Quit        ';
  28.  
  29.   TheMenu[10] :=  '\Edit ';
  30.  
  31.   TheMenu[11] :=  '\Run ';
  32.  
  33.   TheMenu[12] := '\Compile     ';
  34.   TheMenu[13] := 'Make         ';
  35.   TheMenu[14] := 'Build        ';
  36.   TheMenu[15] := 'Destination  ';
  37.   TheMenu[16] := 'Find Error   ';
  38.   TheMenu[17] := 'Primary file ';
  39.   TheMenu[18] := 'Find         ';
  40.   TheMenu[19] := 'find/Replace ';
  41.   TheMenu[20] := 'find Next    ';
  42.   TheMenu[21] := 'Get Info     ';
  43.  
  44.   TheMenu[22] := '\Options';
  45.   TheMenu[23] := 'Compiler    ';
  46.   TheMenu[24] := 'Environment ';
  47.   TheMenu[25] := 'Directories ';
  48.   TheMenu[26] := 'Parameters  ';
  49.   TheMenu[27] := 'Load Options';
  50.   TheMenu[28] := 'Save Options';
  51.   TheMenu[29] := '\\';
  52.  
  53. end; {Proc Define demo menu}
  54.  
  55. Procedure Fill_Screen_With_Junk;
  56. var I,J : integer;
  57. begin
  58.     ClrScr;
  59.     Fillscreen(1,1,80,23,15,0,chr(001));
  60.     WriteCenter(24,15,0,'ESC to exit Menu or F1 for Help');
  61. end;
  62.  
  63. {$F+}
  64. Procedure Menu_Help(Var ChM:Char;PickM,PickS : byte);
  65. {an example of how to hook other procedures into the menu system}
  66. var Ch : char;
  67. begin
  68.     If ChM = #187 then
  69.     begin
  70.         MkWin(20,7,60,15,white,red,1);
  71.         WriteAT(22,9,white,red,'This could be context sensitive');
  72.         WriteAT(22,10,white,red,'about the highlighted pick:');
  73.         GotoXY(25,12);Write('Main Pick ',PickM);
  74.         GotoXY(25,13);Write('Sub  Pick ',PickS);
  75.         Ch := GetKey;
  76.         RmWin;
  77.     end;
  78. end;
  79. {$F-}
  80.  
  81.  
  82. var
  83.  Major,Minor : byte;
  84.  Ch : char;
  85.  
  86. begin   {main demo program}
  87.     Define_Demo_Menu;
  88.     Fill_Screen_With_Junk;
  89.     Major := 1;
  90.     Minor := 4;
  91.     PM_UserHook := @Menu_Help;
  92.     With PM do
  93.     begin
  94.         Style := 0;  {0 no border, 1 single border, 2 double border}
  95.         TopX :=  1;
  96.         TopY := 2;
  97.         ScreenNo := 3;
  98.         Gap :=  5;
  99.     end; {With}
  100.     Pull_Menu(TheMenu,Major,Minor);
  101.     GotoXY(1,20);
  102.     If Major = 0 then
  103.        write('You escaped')
  104.     else
  105.        write('You selected main menu ',Major,' and sub-topic ',Minor);
  106.     WriteAT(1,22,white,black,'Run DemoTTT.exe for the main demo program');
  107.     WriteAT(1,23,white,black,'Technojocks Turbo Toolkit v4.0');
  108.     Ch := Readkey;
  109. end.
  110.